{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Ochre.TopLevel
-- Copyright   :  (c) Stephen Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Top-level functions for running the compiler.
--
--------------------------------------------------------------------------------

module Ochre.TopLevel
  (

    RateId(..)          -- re-export
  , CompilerOpts(..)    -- re-export
  , default_opts        -- re-export

  , compileOrch
  , compileOrchU

  , debugInstr
  , debugInstrAlpha
  , debugInstrAlphaBeta
  , debugInstrAlphaBetaAssoc
  , debugInstrAlphaBetaAssocCF
  , debugInstrOptimize1
  , debugInstrOptimize2
  , debugInstrOptimize3
  

  ) where

import Ochre.Compiler.Alpha ( alpha )
import Ochre.Compiler.Assoc ( assoc )
import Ochre.Compiler.Beta ( beta )
import Ochre.Compiler.Compile 
import Ochre.Compiler.CompilerMon ( Compiler )
import Ochre.Compiler.ConstFold ( constFold )
import Ochre.Compiler.Syntax
import Ochre.Compiler.VarId
import Ochre.Language.Prim

import Control.Monad

compileOrch :: CompilerOpts -> Orch () -> Either ErrMsg String
compileOrch opts ma = execOrch ma >>= compileOrchestra opts

compileOrchU :: CompilerOpts -> Orch () -> String
compileOrchU opts ma = either error (compileOrchestraU opts) $ execOrch ma

debugInstr :: Int -> Instr -> Either ErrMsg String
debugInstr num inst = fmap debugInstrument $ getInstr inst num

debugInstrAlpha :: Int -> Instr -> Either ErrMsg String
debugInstrAlpha = debugInstrF alpha


-- | Allow running and printing of specific compiler passes...
--
debugInstrF :: (Expr -> Compiler Expr) -> Int -> Instr -> Either ErrMsg String
debugInstrF mf num inst = debugInstrumentF mf =<< getInstr inst num


debugInstrAlphaBeta :: Int -> Instr -> Either ErrMsg String
debugInstrAlphaBeta = debugInstrF (alpha >=> beta)

debugInstrAlphaBetaAssoc :: Int -> Instr -> Either ErrMsg String
debugInstrAlphaBetaAssoc = debugInstrF (alpha >=> beta >=> assoc)

debugInstrAlphaBetaAssocCF :: Int -> Instr -> Either ErrMsg String
debugInstrAlphaBetaAssocCF = 
    debugInstrF (alpha >=> beta >=> assoc >=> constFold)

debugInstrOptimize1 :: Int -> Instr -> Either ErrMsg String
debugInstrOptimize1 = 
    debugInstrF (alpha >=> optimizeSteps)

debugInstrOptimize2 :: Int -> Instr -> Either ErrMsg String
debugInstrOptimize2 = 
    debugInstrF (alpha >=> repeatM 2 optimizeSteps)

debugInstrOptimize3 :: Int -> Instr -> Either ErrMsg String
debugInstrOptimize3 = 
    debugInstrF (alpha >=> repeatM 3 optimizeSteps)



